home *** CD-ROM | disk | FTP | other *** search
- {
- Program: Expand
- Date: 11/18/95
- Purpose: To create a visual component library (vcl) for Delphi
- }
- Unit Expand;
-
- interface
-
- Uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, StdCtrls, Controls,
- Forms, Dialogs, Menus, DsgnIntf, About, LZExpand;
-
- type
- TCommand = (cmYes, cmNo);
- TOverwrite = (owAlways, owAsk, owNever);
- TOverwriteEvent = procedure(const FileName: String; var Command: TCommand) of object;
- EExpandFileBad = class(Exception);
- EExpandFileNotFound = class(Exception);
- EExpandNoFiles = class(Exception);
-
- { TExpand }
-
- TExpand = class(TComponent)
- private
- { Private declarations }
- FAbout: TAbout;
- FFilesToProcess: TStrings;
- FExtractDirectory: String;
- FExpandedFileName: String;
- FMoveFiles: Boolean;
- FOverwrite: TOverwrite;
- FOnNextFile: TNotifyEvent;
- FOnOverwrite: TOverwriteEvent;
- function GetFilesToProcess: TStrings;
- procedure SetFilesToProcess(Value: TStrings);
- procedure SetOverwrite(Value: TOverwrite);
- protected
- { Protected declarations }
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function Extract: Integer;
- published
- { Published declarations }
- property About: TAbout read FAbout write FAbout stored False;
- property FilesToProcess: TStrings read GetFilesToProcess write SetFilesToProcess stored True;
- property ExtractDirectory: String read FExtractDirectory write FExtractDirectory stored True;
- property ExpandedFileName: String read FExpandedFileName;
- property MoveFiles: Boolean read FMoveFiles write FMoveFiles stored True;
- property Overwrite: TOverwrite read FOverwrite write SetOverwrite stored True;
- property OnNextFile: TNotifyEvent read FOnNextFile write FOnNextFile;
- property OnOverwrite: TOverwriteEvent read FOnOverwrite write FOnOverwrite;
- end;
-
- procedure Register;
-
- implementation
-
- { TExpand }
-
- constructor TExpand.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FOverwrite:=owAsk; { Default 'owAsk' }
- FFilesToProcess:=TStringList.Create;
- LZStart;
- FilesToProcess:=nil;
- end;
-
- function TExpand.GetFilesToProcess: TStrings;
- begin
- Result := FFilesToProcess;
- end;
-
- procedure TExpand.SetFilesToProcess(Value: TStrings);
- begin
- if Value<>nil then FFilesToProcess.Assign(Value);
- end;
-
- procedure TExpand.SetOverwrite(Value: TOverwrite);
- begin
- if Value<>FOverwrite then FOverwrite:=Value;
- end;
-
- destructor TExpand.Destroy;
- begin
- FFilesToProcess.Free;
- LZDone;
- inherited Destroy;
- end;
-
- function TExpand.Extract: Integer;
- var I:Integer;
- CommpressFileName,ExpandFileName:array [0..79] of Char;
- ReOpenBuff:TOfStruct;
- hCompressFile:Integer;
- hExpandFile:Integer;
- Cmd:TCommand;
- begin
- if FFilesToProcess.Count>0 then
- for I:=0 to Pred(FFilesToProcess.Count) do
- begin
- { Open the Commpressed file }
- StrPCopy(CommpressFileName,FFilesToProcess.Strings[I]);
- hCompressFile:=LZOpenFile(CommpressFileName,ReOpenBuff,of_Read);
- if hCompressFile<>-1 then
- begin
- { Open the Expanded file }
- GetExpandedName(CommpressFileName,ExpandFileName);
- FExpandedFileName:=ExtractFileName(StrPas(ExpandFileName));
- if Length(FExtractDirectory)>3 then StrPCopy(ExpandFileName,FExtractDirectory+'\')
- else StrPCopy(ExpandFileName,FExtractDirectory);
- StrPCopy(@ExpandFileName[StrLen(ExpandFileName)],FExpandedFileName);
- { Fire Event Next file }
- if Assigned(FOnNextFile) then FOnNextFile(Self);
- Cmd:=cmYes; { Default return = Overwrite }
- { If overwrite then Fire Event Overwrite }
- if (FOverwrite=owAsk)and
- (FileExists(StrPas(ExpandFileName)))and
- (Assigned(FOnOverwrite)) then FOnOverwrite(StrPas(ExpandFileName),Cmd);
- if (not FileExists(StrPas(ExpandFileName)))or
- (FOverwrite=owAlways)or((FOverwrite=owAsk)and(Cmd=cmYes)) then
- begin
- hExpandFile:=LZOpenFile(ExpandFileName,ReOpenBuff,of_Create);
- { DeCommpress the files }
- if LZCopy(hCompressFile,hExpandFile)<0 then
- raise EExpandFileBad.Create('Insufficient space or memory, or source file is bad.');
- { Close compressed and expanded files }
- LZClose(hCompressFile);
- LZClose(hExpandFile);
- { Delete compressed file if need (move) }
- if FMoveFiles then DeleteFile(FFilesToProcess.Strings[I]);
- end else LZClose(hCompressFile);
- end
- else
- raise EExpandFileNotFound.Create('File not found '+FFilesToProcess.Strings[I]);
- end
- else
- raise EExpandNoFiles.Create('No files to decompress');
- end;
-
- procedure Register;
- begin
- RegisterComponents('Wizard', [TExpand]);
- RegisterPropertyEditor(TypeInfo(TAbout), nil, '', TAboutProperty);
- end;
-
- begin
- end.